/*
    $VER: $Id: SortIndex.mm,v 1.2 1994/06/20 01:08:30 tf Exp $

    This script sorts an Aminet index file either by the filenames
    or by the pathname.  LONG index files are supported.

    Unless you do not pass the QUICK option, the index header will
    remain unchaned and the given FILE or DIR option sets the
    primary sort creterium.
    If on the other hand the QUICK option has been seen, SortIndex
    will use no secondary search creterium and it will destroy
    the index file header.

    This ARexx script needs the AmigaDOS commands "Sort", "Rename",
    and "Delete" available in your path.

    Initial revision by Tobias Ferber, 30.4.94
*/

options results
options failat 21

CALL PRAGMA('S',102400)

/* initialize globals */

template   = "FROM/K/A,FILE/S,DIR/S,QUICK/S,AUTO/S"
filename   = ""
tempfile   = ""
oldfile    = ""
args       = ""
cliopts    = ""

dg       = 0  /* gauge increment */
ESC      = '1b'x

signal on HALT
signal on BREAK_C
signal on BREAK_D


/* parse args */

do ac=1 while ac <= arg()
  av= arg(ac)
  select
    when upper(av) = "FROM" then do
      if ac < arg() then do
        ac= ac+1
        filename= arg(ac)
        end
      else exit bad_args('Missing filename after' ESC'bFROM'ESC'n keyword.')
      end /* FROM */

    when upper(av) = "FILE" then do
      if (lastpos('d',cliopts) < 1) then cliopts = cliopts || 'f'
      else exit bad_args('Only one of' ESC'bFILE'ESC'n or' ESC'bDIR'ESC'n is allowed.')
      end /* FILE */

    when upper(av) = "DIR" then do
      if (lastpos('f',cliopts) < 1) then cliopts = cliopts || 'd'
      else exit bad_args('Only one of' ESC'bFILE'ESC'n or' ESC'bDIR'ESC'n is allowed.')
      end /* DIR */

    when upper(av) = "QUICK" then cliopts = cliopts || 'q'
    when upper(av) = "AUTO"  then cliopts = cliopts || 'a'

    otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')

    end /* select */

  end /* do */

call pragma('W','N')


/* eventually try to get missing from file */

if words(filename) < 1 then do
  cwd= strip(pragma('D'),'B','"')
  REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select index file to sort..."' NOICONS
  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then filename= result
  end

if words(filename) < 1 then
  exit bad_args("Not enough arguments for SortIndex...*nExiting...")

if (words(filename) > 0) & ~exists(filename) then do
  REQUESTCHOICE TITLE   '"SortIndex Request"',
                BODY    '"SortIndex failed to locate your FROM file*n*n' ||,
                        ESC'c'ESC'b' || filename || ESC'n'ESC'l'         || '"',
                GADGETS '"Exit"'
  exit 10
  end

if (pos('f',cliopts) < 1) & (pos('d',cliopts) < 1) then do
  REQUESTCHOICE TITLE   '"SortIndex Request"',
                BODY    '"Select the sort creterium for*n*n'        ||,
                        ESC'c'ESC'b' || filename || ESC'n'ESC'l'   || '"',
                GADGETS '"_Filename|_Directory|_Cancel"'

  if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then select
    when result = '1' then cliopts= cliopts || 'f'
    when result = '2' then cliopts= cliopts || 'd'
    otherwise              cliopts= ""
    end

  end

if words(cliopts) < 1 then exit

signal on ERROR
signal on IOERR

signal on FAILURE
/*signal on NOVALUE*/
signal on SYNTAX


/* do the hard part */

MESSAGE CLEAR; MESSAGE OPEN; COMPLETE 0
if pos('d',cliopts) > 0 then do; scol= 22; WORKING '"Sorting' filename 'by directory ..."'; end
                        else do; scol=  1; WORKING '"Sorting' filename 'by filename ..."' ; end

COMPLETE 5

IF POS('q',cliopts) > 0 THEN DO

  tempfile= filename || '.' || pragma('Id')

  MESSAGE transquote('Renaming "'filename'" to "'tempfile'" ...')
  IF EXISTS(tempfile) THEN ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
  ADDRESS COMMAND 'Rename QUIET FROM "'filename'" TO "'tempfile'"'

  COMPLETE 10

  MESSAGE transquote('Sorting "'tempfile'" to "'filename'" ...')
  ADDRESS COMMAND 'Sort FROM "'tempfile'" TO "'filename'" COLSTART' scol

  COMPLETE 90

  MESSAGE transquote('Deleting temprary index file "'tempfile'" ...')
  ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
  END

ELSE DO /* Save index header */

  tempfile= "T:" || fileonly(filename) || '.' || pragma('Id')
  oldfile= filename || '.OLD'

  IF EXISTS(oldfile) THEN DO
    REQUESTCHOICE TITLE   '"SortIndex Request"',
                  BODY    '"Ooops!  Index backup file*n*n'             ||,
                          ESC'c'ESC'b' || oldfile || ESC'n'ESC'l*n*n'  ||,
                          'already exists.  May I replace it?'       || '"',
                  GADGETS '"**_Yes|_No"'

    IF result = 0 THEN DO
      REQUESTCHOICE TITLE '"SortIndex Request"' BODY '"SortIndex canceled"' GADGETS '"Exit"'
      EXIT
      END

    MESSAGE transquote('Deleting "'oldfile'" ...')
    ADDRESS COMMAND 'Delete QUIET FILE "'oldfile'"'
    END

  COMPLETE 10
  MESSAGE transquote('Renaming "'filename'" to "'oldfile'" ...')
  ADDRESS COMMAND 'Rename QUIET FROM "'filename'" TO "'oldfile'"'

  COMPLETE 20
  MESSAGE transquote('Writing header to "'filename'" ...')

  IF ~OPEN('in',oldfile,'R') THEN DO
    REQUESTCHOICE TITLE   '"SortIndex Request"',
                  BODY    '"Failed to open your old index file*n*n' ||,
                          ESC'c'ESC'b' || oldfile || ESC'n'ESC'l'   || '"',
                  GADGETS '"Exit"'
    EXIT
    END

  COMPLETE 25

  IF ~OPEN('out',filename,'W') THEN DO
    REQUESTCHOICE TITLE   '"SortIndex Request"',
                  BODY    '"Could not write to*n*n'                ||,
                          ESC'c'ESC'b' || filename || ESC'n'ESC'l' || '"',
                  GADGETS '"Exit"'
    EXIT
    END

  COMPLETE 30

  line= "|"
  DO UNTIL (LEFT(line,1) ~= '|') | EOF('in')
    line= READLN('in')
    IF LEFT(line,1) = '|' THEN WRITELN('out',line)
    END

  CALL CLOSE('out')

  COMPLETE 40
  MESSAGE transquote('Generating temporary index file "'tempfile'" ...')

  IF ~OPEN('out',tempfile,'W') THEN DO
    REQUESTCHOICE TITLE   '"SortIndex Request"',
                  BODY    '"Could not write to*n*n'                ||,
                          ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
                  GADGETS '"Exit"'
    EXIT
    END

  COMPLETE 45
  numentries= 0

  /* write tempfile for a sort by dir */
  IF POS('d',cliopts) > 0 THEN DO UNTIL EOF('in')
    PARSE VAR line fname pname . 33 rest
    CALL WRITELN('out',pname || '09'x || fname || '09'x || rest)
    numentries= numentries +1
    line= READLN('in')
    END

  /* write tempfile for a sort by file */
  ELSE DO UNTIL EOF('in')
    PARSE VAR line fname pname . 33 rest
    CALL WRITELN('out',fname || '09'x || pname || '09'x || rest)
    numentries= numentries +1
    line= READLN('in')
    END

  COMPLETE 70

  /* initialize the gauge increment */
  IF numentries > 0 THEN dg = 100 / numentries

  CALL CLOSE('out')
  CALL CLOSE('in')

  COMPLETE 75

  MESSAGE transquote('Sorting "'tempfile'" ...')
  ADDRESS COMMAND 'Sort FROM "'tempfile'" TO "'tempfile'"'

  COMPLETE 90
  MESSAGE transquote('Appending "'tempfile'" to "'filename'" ...')

  IF ~OPEN('in',tempfile,'R') THEN DO
    REQUESTCHOICE TITLE   '"SortIndex Request"',
                  BODY    '"Could not read from*n*n'               ||,
                          ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
                  GADGETS '"Exit"'
    EXIT
    END

  COMPLETE 95

  IF ~OPEN('out',filename,'A') THEN DO
    REQUESTCHOICE TITLE   '"SortIndex Request"',
                  BODY    '"Could not write to*n*n'                ||,
                          ESC'c'ESC'b' || filename || ESC'n'ESC'l' || '"',
                  GADGETS '"Exit"'
    EXIT
    END

  COMPLETE 100

  /* read tempfile sorted by dir */
  IF POS('d',cliopts) > 0 THEN DO UNTIL EOF('in')
    line= READLN('in')
    numentries= numentries - 1;
    COMPLETE 100 - TRUNC( MAX(numentries * dg,0) )
    IF WORDS(line) > 0 THEN DO
      PARSE VAR line pname '09'x fname '09'x rest
      CALL WRITELN('out', LEFT(fname,20,' ') || ' ' ||,
                          LEFT(pname,10,' ') || ' ' ||  rest)
      END
    END

  /* read tempfile sorted by file */
  ELSE DO UNTIL EOF('in')
    line= READLN('in')
    numentries= numentries - 1;
    COMPLETE 100 - TRUNC( MAX(numentries * dg,0) )
    IF WORDS(line) > 0 THEN DO
      PARSE VAR line fname '09'x pname '09'x rest
      CALL WRITELN('out', LEFT(fname,20,' ') || ' ' ||,
                          LEFT(pname,10,' ') || ' ' ||  rest)
      END
    END

  CALL CLOSE('out')
  CALL CLOSE('in')

  MESSAGE transquote('Deleting old index file "'oldfile'" ...')
  ADDRESS COMMAND 'Delete QUIET FILE "'oldfile'"'

  MESSAGE transquote('Deleting temprary index file "'tempfile'" ...')
  ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'

  END /* Save index header */

COMPLETE 100
MESSAGE '"done."'
IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
exit 0


bad_args: PROCEDURE EXPOSE template ESC
  PARSE ARG msg
  REQUESTCHOICE TITLE   '"SortIndex Request"',
                BODY    '"' || msg || '*n*n'                     ||,
                        'SortIndex args template:*n*n'           ||,
                        ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
                GADGETS '"Okay"'
  RETURN 0

/*@*/


/* translate '"' into '*"' and '*' into '**' */

transquote: procedure
  parse arg s
  t= s
  q= max( lastpos('*',s), lastpos('"',s) )
  do while q > 0
    t= insert('*',t,q-1,1)
    s= left(s,q-1)
    q= max( lastpos('*',s), lastpos('"',s) )
    end
  return '"' || t || '"'


/* return the non-file part of a pathname */

pathonly: procedure
  parse arg path
  if (words(path) > 0) & (right(path,1) ~= ':') then do
    if right(path,1) = '/' then path= left(path,length(path)-1)
    if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
                                             else path= left(path,lastpos(':',path))
    end
  return path


/* return the file part of a pathname */

fileonly: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  p= max( lastpos(':',path), lastpos('/',path) )
  if(p>0) then return substr(path,p+1)
          else return path


/* concatenate the filename to the pathname and return the resulting string */

tackon: procedure
  parse arg path,file
  do while left(file,1) = '/'
    file= substr(file,2)
    path= pathonly(path)
    end
  if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  if (right(file,1) = '/') then file= left(file,length(file)-1)
  return path || file


/* create all non-existant directories in a path */

makepath: procedure
  parse arg path
  if right(path,1) = '/' then path= left(path,length(path)-1)
  if ~exists(path) then do
    call makepath( pathonly(path) )
    address command 'MakeDir NAME "'path'"'
    end
  return 0


/*
 * return   1  if the device or volume name in given pathname exists
 *             or if no device or volume was present (current device)
 *          0  if the device or volume name does not exist
 */

canexist: procedure
  parse upper arg path
  if pos(':',path) < 1 then return 1 /* current device */
  call pragma('W','N')
  return exists( left(path,lastpos(':',path)) )


/* error/break handling */

IOERR:
ERROR:
  err= rc
  ESC = '1b'x

  signal off ERROR
  signal off IOERR

  WORKING '"I/O problem trapped... Execution halted."'
  MESSAGE '"I/O problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"SortIndex Error Trap' err'"',
                BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
                GADGETS '"I''ll better exit"'
  exit


FAILURE:
NOVALUE:
SYNTAX:
  err= rc
  ESC = '1b'x

  signal off FAILURE
  signal off NOVALUE
  signal off SYNTAX

  WORKING '"Internal problem trapped... Execution halted."'
  MESSAGE '"Internal problem trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"SortIndex Internal Error' err'"',
                BODY    '"SortIndex seems to have an internal problem in line' sigl '...*n' ||,
                        ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                      || '"',
                GADGETS '"I''ll better exit"'
  exit


HALT:
BREAK_C:
BREAK_D:
  signal off HALT
  signal off BREAK_C
  signal off BREAK_D

  WORKING '"Break signal trapped... Execution halted."'
  MESSAGE '"Break signal trapped... Execution halted."'

  REQUESTCHOICE TITLE   '"SortIndex Break Trap"',
                BODY    '"Script execution halted."',
                GADGETS '"Stop"'
  exit
